home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / EGL_PointC215941872009.psc / PointCloud V1.1 / clsFileEPJ.cls < prev    next >
Text File  |  2009-08-06  |  2KB  |  76 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsFileEPJ"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. '
  16. ' EPJ File parser (EGL Point Cloud Job file)
  17. ' Creator   : EGL Point Cloud V1
  18. '             This is a my format.
  19. '             This version, load a single object
  20. ' Author    : Erkan ▐anl² July2009
  21. ' Copyright : Free code
  22. ' Version   : 1.0
  23.  
  24. Private Type Header
  25.     Signature       As String * 3   '"EPJ"
  26.     Version         As Byte
  27. End Type
  28.  
  29. Dim fHeader         As Header
  30.  
  31. Public Sub WriteEPJ(FileName As String)
  32.     
  33.     Dim hFile       As Long
  34.     
  35.     On Error GoTo err
  36.     If FileExist(FileName) Then Kill FileName
  37.     
  38.     fHeader.Signature = "EPJ"
  39.     fHeader.Version = 1
  40.         
  41.     hFile = FreeFile
  42.     Open FileName For Binary As hFile
  43.         Put #hFile, , fHeader
  44.         Put #hFile, , Dots1
  45.         Put #hFile, , Mesh1
  46.     Close #hFile
  47. err:
  48.     Close #hFile
  49. End Sub
  50.  
  51. Public Sub ReadEPJ(FileName As String)
  52.     
  53.     Dim hFile   As Long
  54.     
  55.     On Error Resume Next
  56.     
  57.     LoadComplete = False
  58.     hFile = FreeFile
  59.     Open FileName For Binary As hFile
  60.  
  61.         Get #hFile, , fHeader
  62.         If fHeader.Signature <> "EPJ" And fHeader.Version = 1 Then 'Check signature
  63.             MsgBox "Wrong file format or version" & vbNewLine & "Abort loading"
  64.             LoadComplete = False
  65.             Exit Sub
  66.         End If
  67.         Get #hFile, , Dots1
  68.         Get #hFile, , Mesh1
  69.     Close #hFile
  70.     Call ResetMeshParameters
  71.     Call ResetCameraParameters
  72.     Call ResetLightParameters
  73.     LoadComplete = True
  74.  
  75. End Sub
  76.